MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 03 - 1987/03.07 Jul 87/LMC source stuff/LMC Source

Text File | 1987-04-26 | 10.2 KB | 410 lines | [TEXT/PJMM]

{        Lazy Man's Color by Steve Sheets 4/20/87        }

{    Simple Demonstration of Mac // Color using the ForeColor & BackColor.    }
{    This program Load and displays a MacPaint document in any 2 colors.        }

PROGRAM LMC;

{    Various Constants:    Menu ID Numbers, Window Size, Window Placement,     }
{        BitMap Size and Number of Colors.    }
    CONST
        AppleMenuID = 300;
        FileMenuID = 301;
        EditMenuID = 302;
        ForeMenuID = 303;
        BackMenuID = 304;

        OffV = 40;
        OffH = 40;
        AboutH = 300;
        AboutV = 140;
        SizeH = 576;
        SizeV1 = 360;
        SizeV2 = 720;
        BitW = 72;
        NumSec = 2;

        XColor = 8;

{    Various Variables:    Menus, Bitmaps, Window, Colors, Done Flag & Title Name    }
    VAR
        Done : boolean;
        AppleMenu, FileMenu, EditMenu, ForeMenu, BackMenu : MenuHandle;

        CWindow : windowptr;
        CMap : ARRAY[1..NumSec] OF bitmap;
        CData : ARRAY[1..NumSec] OF handle;

        ForeC, BackC : integer;
        Title : str255;

{    Given Color Number (from 1 to XColor, as if selected by Menu),        }
{        returns actual longint Color Number (for ForeColor or BackColor).    }
    FUNCTION GetColor (N : integer) : longint;
    BEGIN
        CASE N OF
            1 :
                GetColor := BlackColor;
            2 :
                GetColor := WhiteColor;
            3 :
                GetColor := RedColor;
            4 :
                GetColor := GreenColor;
            5 :
                GetColor := BlueColor;
            6 :
                GetColor := CyanColor;
            7 :
                GetColor := MagentaColor;
            8 :
                GetColor := YellowColor;
            OTHERWISE
                GetColor := WhiteColor;
        END;
    END;

{    Sets new ForeColor & BackColor and forces an Update so Window is    }
{        redrawn in the new colors.    }
    PROCEDURE DoColor (F, B : integer);
        VAR
            count : integer;
            tempPort : Grafptr;
    BEGIN
        GetPort(tempPort);
        SetPort(CWindow);

        IF F <> ForeC THEN
            BEGIN
                FOR count := 1 TO XColor DO
                    CheckItem(ForeMenu, count, count = F);
                ForeC := F;
                ForeColor(GetColor(ForeC));
            END;

        IF B <> BackC THEN
            BEGIN
                FOR count := 1 TO XColor DO
                    CheckItem(BackMenu, count, count = B);
                BackC := B;
                BackColor(GetColor(BackC));
            END;

        InvalRect(CWindow^.portRect);

        SetPort(tempPort);
    END;

{    Loads MacPaint Picture in Bitmaps and displays it.    }
    PROCEDURE DoLoad;
        TYPE
            diskBlock = PACKED ARRAY[1..512] OF QDbyte;
        VAR
            MyReply : SFReply;
            MyType : SFtypelist;
            tempPoint : point;
            count : longint;
            refNum, scanline, N : integer;
            error : OSErr;
            srcBuf : ARRAY[1..2] OF diskBlock;
            srcPtr, dstPtr : Ptr;
    BEGIN
        tempPoint.v := 60;
        tempPoint.h := 60;
        MyType[0] := 'PNTG';
        SFGetFile(tempPoint, '', NIL, 1, MyType, NIL, MyReply);
        IF MyReply.good THEN
            BEGIN
                Hlock(CData[1]);
                Hlock(CData[2]);

                IF FSOpen(MyReply.fname, MyReply.vrefnum, refNum) = noErr THEN
                    BEGIN

                        count := 512;
                        error := FSRead(refNum, count, @srcBuf);

                        count := 1024;
                        error := FSRead(refNum, count, @srcBuf);
                        srcPtr := @srcBuf;

                        FOR N := 1 TO NumSec DO
                            BEGIN
                                dstPtr := CData[N]^;
                                FOR scanline := 1 TO SizeV1 DO
                                    BEGIN
                                        UnpackBits(srcPtr, dstPtr, BitW);
                                        IF ord(srcPtr) > (ord(@srcBuf) + 512) THEN
                                            BEGIN
                                                srcBuf[1] := srcBuf[2];
                                                count := 512;
                                                error := FSRead(refNum, count, @srcBuf[2]);
                                                srcPtr := pointer(ord(srcPtr) - 512);
                                            END;
                                    END;
                            END;

                        error := FSClose(refNum);
                    END;
                HUnlock(CData[1]);
                HUnlock(CData[2]);
            END;

        DoColor(ForeC, BackC);
    END;

{    Creates a Rectangle centered on Screen (if window size is smaller then    }
{    the screen) or starting at a standard offset (if window size is larger then    }
{    then screen).    }
    PROCEDURE CenterRect (VAR R : rect;
                                    H, V : integer);
        VAR
            tempH : integer;
    BEGIN
        IF H > Screenbits.bounds.right THEN
            tempH := OffH
        ELSE
            tempH := ((Screenbits.bounds.right - H) DIV 2);
        SetRect(R, tempH, OffV, H + tempH, V + OffV);
    END;

{    Draws text, centered in a rectangle in the About Box window in a    }
{    certain color with a certain justification    }
    PROCEDURE DoLine (S : str255;
                                    H, Top, Bottom, J : integer;
                                    C : longint);
        VAR
            tempInteger : integer;
            tempRect : rect;
    BEGIN
        ForeColor(C);
        tempInteger := ((AboutH - H) DIV 2);
        SetRect(tempRect, tempInteger, Top, tempInteger + H, Bottom);
        TextBox(POINTER(ord(@S) + 1), LENGTH(S), tempRect, J);
    END;

{    Displays About Box (in color) until someone presses the button down.    }
    PROCEDURE DoAbout;
        VAR
            tempWindow : windowptr;
            tempRect : rect;
            tempStr : str255;
    BEGIN
        CenterRect(tempRect, AboutH, AboutV);
        tempWindow := NewWindow(NIL, tempRect, '', true, dBoxProc, POINTER(-1), false, 0);
        SetPort(tempWindow);
        TextFont(0);

        DoLine(CONCAT(Title, ' by Steve Sheets'), AboutH, 20, 39, teJustCenter, BlueColor);
        DoLine('Sample Mac // Color Program', AboutH, 40, 59, teJustCenter, GreenColor);
        DoLine('This program uses the ForeColor and BackColor Quickdraw commands to display a MacPaint document in two colors.', AboutH - 50, 60, AboutV, teJustLeft, RedColor);

        WHILE NOT button DO
            ;

        DisposeWindow(tempWindow);
    END;

{    Standard main menu procedure that handles menu selections.  Can show    }
{    About Box, open Desk Accessories, Load in MacPaint file, change the Done        }
{    Flag (so the program quits), handle edit commands (Cut,Copy,Paste,Clear),    }
{    and change Foreground or Background color of the picture.}
    PROCEDURE MainMenu (tempResult : LONGINT);
        VAR
            tempInteger : integer;
            tempBoolean : boolean;
            tempStr : STR255;
    BEGIN
        tempInteger := LoWord(tempResult);
        CASE HiWord(tempResult) OF
            AppleMenuID :
                IF tempInteger = 1 THEN
                    DoAbout
                ELSE
                    BEGIN
                        GetItem(appleMenu, tempInteger, tempStr);
                        tempInteger := OpenDeskAcc(tempStr);
                    END;
            FileMenuID :
                CASE tempInteger OF
                    1 :
                        DoLoad;
                    3 :
                        Done := true;
                    OTHERWISE
                END;
            EditMenuID :
                tempBoolean := SystemEdit(tempInteger - 1);
            ForeMenuID :
                IF (tempInteger > 0) AND (tempInteger <= XColor) THEN
                    DoColor(tempInteger, BackC);
            BackMenuID :
                IF (tempInteger > 0) AND (tempInteger <= XColor) THEN
                    DoColor(ForeC, tempInteger);
            OTHERWISE
        END;
        HiliteMenu(0);
    END;

{    Setup for Menus, Window, Bitmaps,  Colors settings, Title and Done flag.    }
    PROCEDURE DoSetup;
        TYPE
            DD = PACKED ARRAY[1..32000] OF 0..255;
            PP = ^DD;
            HH = ^PP;
        VAR
            tempStr : STR255;
            tempRect : rect;
            count : integer;
            tempLong : longint;
            tempH : HH;
    BEGIN
        Title := 'Lazy Man@s Color';
        Title[9] := CHR(39);

        tempStr := ' ';
        tempStr[1] := CHR(appleMark);
        AppleMenu := NewMenu(AppleMenuID, tempStr);
        AppendMenu(AppleMenu, CONCAT('About ', Title, '...;(-'));
        AddResMenu(AppleMenu, 'DRVR');

        FileMenu := NewMenu(FileMenuID, 'File');
        AppendMenu(FileMenu, 'Load MacPaint Documents/L;(-;Quit/Q');

        EditMenu := NewMenu(EditMenuID, 'Edit');
        AppendMenu(EditMenu, 'Undo/Z;(-;Cut/X;Copy/C;Paste/V;Clear');

        ForeMenu := NewMenu(ForeMenuID, 'Set Foreground');
        AppendMenu(ForeMenu, 'Black;White;Red;Green;Blue;Cyan;Magenta;Yellow');

        BackMenu := NewMenu(BackMenuID, 'Set Background');
        AppendMenu(BackMenu, 'Black;White;Red;Green;Blue;Cyan;Magenta;Yellow');

        InsertMenu(AppleMenu, 0);
        InsertMenu(FileMenu, 0);
        InsertMenu(EditMenu, 0);
        InsertMenu(ForeMenu, 0);
        InsertMenu(BackMenu, 0);

        DrawMenuBar;

        CenterRect(tempRect, SizeH, SizeV2);
        CWindow := NewWindow(NIL, tempRect, Title, true, 4, POINTER(-1), false, 0);

        CMap[1].rowBytes := BitW;
        SetRect(CMap[1].bounds, 0, 0, SizeH, SizeV1);
        CData[1] := NewHandle(BitW * SizeV1);
        IF CData[1] <> NIL THEN
            BEGIN
                tempH := HH(CData[1]);
                FOR count := 1 TO BitW * SizeV1 DO
                    tempH^^[count] := 0;
            END;
        CMap[2].rowBytes := BitW;
        SetRect(CMap[2].bounds, 0, SizeV1, SizeH, SizeV2);
        CData[2] := NewHandle(BitW * SizeV1);
        IF CData[2] <> NIL THEN
            BEGIN
                tempH := HH(CData[2]);
                FOR count := 1 TO BitW * SizeV1 DO
                    tempH^^[count] := 0;
            END;

        IF (CData[1] = NIL) OR (CData[2] = NIL) THEN
            BEGIN
                SetWTitle(CWindow, 'Not Enough Memmory');
                DisableItem(FileMenu, 1);
            END;

        ForeC := 0;
        BackC := 0;
        DoColor(1, 2);

        InitCursor;

        Done := false;
    END;

{    Standard main program loop that handles all events (ie. mouse down, key    }
{    downs & updates) until the Done flag is set.    }
    PROCEDURE MainLoop;
        VAR
            tempEvent : EventRecord;
            tempWindow : windowptr;
            tempCode : integer;
            tempPort : Grafptr;
            tempRect : rect;
    BEGIN
        REPEAT
            SystemTask;
            IF GetNextEvent(everyEvent, tempEvent) THEN
                BEGIN
                    CASE tempEvent.what OF
                        mouseDown :
                            BEGIN
                                tempCode := FindWindow(tempEvent.where, tempWindow);
                                CASE tempCode OF
                                    inDrag, inContent :
                                        BEGIN
                                            IF tempWindow <> FrontWindow THEN
                                                SelectWindow(tempWindow)
                                            ELSE
                                                BEGIN
                                                    IF Cwindow = tempWindow THEN
                                                        BEGIN
                                                            IF CWindow <> FrontWindow THEN
                                                                SelectWindow(CWIndow)
                                                            ELSE
                                                                BEGIN
                                                                    SetRect(tempRect, -25000, -25000, 25000, 25000);
                                                                    DragWindow(CWindow, tempEvent.where, tempRect);
                                                                END;
                                                        END;
                                                END;
                                        END;
                                    inMenuBar :
                                        MainMenu(MenuSelect(tempEvent.where));
                                    inSysWindow :
                                        SystemClick(tempEvent, tempWindow);
                                    OTHERWISE
                                END; { of tempCode case }
                            END; { of mouseDown }
                        keydown, autoKey :
                            IF BitAnd(tempEvent.modifiers, cmdKey) <> 0 THEN
                                MainMenu(MenuKey(CHR(tempEvent.message MOD 256)));
                        updateEvt :
                            IF CWindow = WindowPtr(tempEvent.message) THEN
                                BEGIN
                                    GetPort(tempPort);
                                    SetPort(CWindow);
                                    BeginUpdate(CWindow);

                                    IF CData[1] <> NIL THEN
                                        BEGIN
                                            Hlock(CData[1]);
                                            CMap[1].baseAddr := CData[1]^;
                                            CopyBits(CMap[1], CWindow^.portBits, CMap[1].bounds, CMap[1].bounds, srcCopy, NIL);
                                            HUnlock(CData[1]);
                                        END;
                                    IF CData[2] <> NIL THEN
                                        BEGIN
                                            Hlock(CData[2]);
                                            CMap[2].baseAddr := CData[2]^;
                                            CopyBits(CMap[2], CWindow^.portBits, CMap[2].bounds, CMap[2].bounds, srcCopy, NIL);
                                            HUnlock(CData[2]);
                                        END;

                                    EndUpdate(CWindow);
                                    SetPort(tempPort);
                                END;
                        OTHERWISE
                    END;
                END;
        UNTIL Done;
    END;

{    ***PROGRAM***    }
BEGIN
    DoSetup;
    MainLoop;
END.